perm filename FOR20.OLD[F8,ALS] blob sn#307781 filedate 1977-10-06 generic text, type T, neo UTF8
*PRINT ON
*PUNCH ON
*CHECKERS REV 0.24
*DATE 10/4/7  VERSION N SHAPERO
*
*Resident package addresses
JOYT    EQU     H'0C00'
LINE    EQU     H'0FDF'
SHCB    EQU     H'0FE2'
INPF    EQU     H'0FE3'
WTLN    EQU     H'0FE5'
TXC     EQU     H'0FE8'
CMRG    EQU     H'0FEA'
DBNC    EQU     H'0FEB'
UPI     EQU     H'0FFA'
JOYI    EQU     H'21AD'
IJS     EQU     H'22DB'
PUSH    EQU     H'40A9'
POPS    EQU     H'40BC'
SPS     EQU     H'40D0'
WAUD    EQU     H'41C8'
WAU1    EQU     H'41CC'
CDS     EQU     H'41D5'
WMS     EQU     H'4205'
UDAT    EQU     H'424D'
TRAN    EQU     H'43CD'
FCS     EQU     H'43D6'
WAIT    EQU     H'4501'
TIR     EQU     H'45DB'
CLER    EQU     H'4762'
*Misc. constants
TCMD    EQU     H'44'
BCMD    EQU     H'6D'
TCOL    EQU     H'80'   TEXT COLOR
ULIN    EQU     H'F5'
COM     EQU     H'8F7'
SLT     EQU     SKL
*
*RAM assignments
PLY0    EQU     H'0C20'        Place for player's ply depth choice
COL0    EQU     H'0C21'        Place for color choice(next after PLY0)
SELX    EQU     H'0C22'        SELE exit (0 NORMAL)
JPSV    EQU     H'0C25'        CURSOR COORDS (0:7,0:7)
JSAV    EQU     H'0C23'        BYTE INFO AND BYTE
OBJ0    EQU     H'C30'
OBJ1    EQU     H'F10'  BOARD 2
TREE    EQU     H'0E10'         Tree data (15 blocks of 16 bytes each)
BLCK    EQU     H'0E10'
RED     EQU     H'0E20'
PLMD    EQU     H'0EC0'         Used for temp store of player's move inf
PLMV    EQU     H'0ED0'         Overlay region used for player's moves
PLMF    EQU     H'0EE0'                 and move numbers
MOBS    EQU     H'0F00'         Mobility and DJ flags (14 bytes)
*
*Scratch pad assignments
J      EQU     H'9'
HU     EQU     H'A'
HL     EQU     H'B'
PLOC   EQU     O'3'            LISU value for ACTIVE and PASSIVE
KLOC   EQU     O'4'            LISU value for KING's and special data
ELOC   EQU     O'5'            LISU value for EMPTY's area
ISA    EQU     O'30'           ISAR value for active area
ISP    EQU     O'34'           ISAR value for passive
ISK    EQU     O'40'           ISAR value for kings
ISE    EQU     O'51'           ISAR value foempty (with offset)
*Mimimum ply depths
PLYT   EQU     H'FE'           Ply depth for Robot Tom (stored as neg.)
PLYD   EQU     H'FD'           Ply depth for Robot Dick
PLYH   EQU     H'FC'           Ply depth for Robot Harry
*
       ORG     H'1000'
       DC      H'AA'
       DC      H'55'
       DC      H'00'   BACKGROUND COLOR
       DC      H'00'   BACKGROUND COLOR
       DC      H'00'   SPACES
       DC      H'00'   SPACES
       DC      H'3119' CH
    α  DC      H'0B31' EC
       DC      H'150B' KE
       DC      H'0921' RS
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*CHECKERS PACKAGE                      *
*                                      *
*  ALGORITHM BY PROF. A. SAMUEL        *
*  I/O ROUTINES BY N. SHAPERO          *
*
       PI      CDS     CLEAR DISPLAY
       PI      IJS     INITIALIZE JOYSTICK TABLE
        LISL    5
        CLR
        XS      S
        BM      QN1     Is clock running?
        LI      H'81'   No, so start it
        LR      I,A
        LIS     2
        LR      S,A
QN1    LIS     H'4'
       LR      0,A
       PI      SEDC    SET MESSAGE LNGTH&LINE POINTER
       DS      1
       DS      1       SET DEFAULT PLY DEPTH
       DCI     SKL
       PI      WMS     WRITE MESSAGE
       PI      RKB     AND DO KEYBOARD READ
       CI      H'1F'
       BZ      QN10    IS IT 'DICK'?
       CI      H'19'   NO.
       BNZ     QN11    IF NOT 'HARRY', THEN 'TOM'
       DS      1
QN10   DS      1
QN11   DCI     PLY0
       LR      A,1     GET CORRECT PLY DEPTH
       ST              AND SAVE IT.
       DS      0
       DS      0       SET FOR BUT TWO LINES
       PI      CDS     CLEAR DISPLAY
       PI      SEDC    SET LINE POINTER
       LI      H'FA'
       AS      S
       LR      S,A     SET FOR BUT H'1A' LENGTH
       DCI     YMF     DCO TO MESSAGE START
       PI      WMS     SO WRITE MESSAGE
       PI      RKB     READ KEYBOARD
       CI      H'2B'   Is answer an N?
        CLR
       BZ     QN13     0 if machine plays black
        COM            FF if machine plays red
QN13   DCI     COL0
       ST              AND SET ACCORDINGLY
        LR      7,A     Save here also
        COM
        ST              Set SELX 
        DCI     BLKM    Table of possible first moves
        XDC
        DCI     PLMV    List to verify moves
        LIS     H'5'
        LISL    0
        LR      S,A             SET TRANSFER COUNT
        PI      TRAN            DO TRANSFER
*Now set up board
QN14   DCI     CMRG
       LI      H'65'
       ST              SET FOR X & Y ZOOM
   DCI   H'8F7'
   ST
        PI      BRDI             Set up initial board
        DCI     JPSV
        LIS     H'7'
        ST
        CLR
        ST                      INITIALIZE CURSOR POSITION
*Start play
        CLR
        AS      7
        BNZ     PMOV            Player is black
        LISU    2
        LISL    5
        LR      A,S             Used as random number
        NI      H'3F'           Save only 6 bits
QN15    CI      H'6'
        BP      QN16
        AI      H'FA'
        BR      QN15
QN16    LR      0,A             Use this number to select move
        DCI     PLMV
QN17    LM                      Ignore count in this case
        LR      1,A
QN18    LR      A,1
        NS      1
        BNZ     QN19            This byte exhausted
        LM
        BR      QN17
QN19    LR      2,A
        AI      H'FF'           Subtract 1
        NS      1
        LR      1,A             byte less rightmost bit
        XS      2
        DS      0
        BNZ     QN18
        LR      6,A
        LM
        LR      4,A             The byte indicator
        DCI     RED             Start here
        LR      H,DC
        LIS     H'C'
        LR      A,6
        ST
        LR      A,4
        ST
        JMP     SELE            Use std code to make move
PMOV    DCI     TREE            Time for player's move
        LR      H,DC
MES0    CLR                     "YOUR MOVE"
MES1    LR      0,A             Identify message
        PI      WMC             Write message
CUR1  PI CTMP
        PI      NOOP
* Can this piece move?
* Enter with X in 1, Y in 2, byte in 3 and byte # in 4
OKPI    DCI    PLMV            Possible moves listing
OKP1    LM                      Get move byte
        NI      H'FF'
        BNZ     OKP3            An entry
        LR      A,5             Byte info
        NI      H'10'           Extract J bit
        LIS     H'5'            "PIECE CAN'T MOVE"
        BZ      OKP2
        LIS     H'1'            "MUST JUMP"
OKP2    BR      MES1            Try again
OKP3    NS      3               Compare
        BNZ     OKP4            This might be the one
        LM                      A cheap way to index
        LR      5,A             Save for jump info
        BR      OKP1            Try again
OKP4    LM                      Next entry is the byte info
        LR      5,A             Save it
        SR      1
        SR      1
        NI      H'3'           Remove the J bit and the direction
        XS      4               Does it match?
        BNZ     OKP1            Try again
        DCI     PLMD            Save data as to starting square
        LR      A,1             X
        ST
        LR      A,2             Y
        ST
        LR      A,3             Byte
        ST
        LR      A,4             Byte info
        ST
        LIS     H'4'
        LR      7,A             Counter
*CODE TO BLINK PIECE GOES HERE
CUR2   PI  CTMP
        PI      NOOP            *--* DEBUGGING AID
*Now test indicated move for legality
OKMV    DCI     PLMD            Saved data location
        LM                      Get the old X value
        COM
        INC
        AS      1               This gives us the change in X
        BZ      NON2            Illegal
        LR      1,A             Save the difference
        BP      OKM1
        COM
        INC
OKM1    LR      0,A             |X|
        CI      H'2'
        BM      NON3            Too far
        CLR                     Anticipate normal move
        BNZ     OKM2
        LI      H'10'           Set Jump bit
OKM2    LR      6,A             save byte info here
        LM                      Get the old Y value
        COM
        INC
        AS      2
        LR      2,A             Change in Y
        BM      OKM3
        COM
        INC
OKM3    AS      0
        BNZ     NON2            |X|≠|Y|
        LR      A,2
        NS      2
        BP      OKM4
        LIS     H'2'            Backward bit
        AS      6
        LR      6,A
OKM4    LR      A,1
        NS      1
        BM      OKM5            
        LIS     H'1'            Left bit
        AS      6
        LR      6,A
OKM5    LR      A,4             BYTE #
        SL      1
        SL      1
        AS      6
        LR      6,A             Final byte info
        DCI    PLMV            Possible moves listing
OKM6    LM                      Get first move byte
        NI      H'FF'
        BZ      NONO            No more entries
        NS      3
        LM
        LR      5,A
        BZ      OKM6            Try again
        XS      6
        BNZ     OKM6            Try again
        DCI     TREE            Store final values
        LR      H,DC
        LIS     H'C'
        ADC
        LR      A,3
        ST                      Store byte
        LR      A,6
        ST                      And byte info
        PI      NOOP       *--* DEBUGGING AID
        LR      DC,H
        JMP     SELE
NONO    LR      A,5
        NI      H'10'           A jump required?
        LIS     H'2'
        BZ      NON4
        LIS     H'1'
        BR      NON4
NON2    LIS     H'2'
        BR      NON4
NON3    LIS     H'3'
        BR      NON4
NON4    DS      7
        BP      NON5
*--* TURN OFF BLINK HERE
        JMP     MES0
NON5    LR      0,A
        PI      WMC
        JMP     CUR2
*-*-*-*-*-*-*-*-*-*-
*      KEYBORD READ
*
RKB    LR      K,P
       PI      PUSH
       LISU    2
       LISL    4       SET ISAR FOR DELAY TIMER
       LIS     H'0'
       LR      S,A     SET FOR MAX DELAY
RKB1   PI      FCS     FETCH CHARACTER
       BZ      RKB1    NULL INPUT?
       BM      RKB1    NO. DEBOUNCED INPUT?
       PI      POPS    YES. POP RETURN ADDRESS
       LR      A,8     GET KEYBOARD INPUT
       PK              AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*-
*Initial moves for black
*
BLKM   DC      B'11110000'      4 pieces
       DC      B'00000100'      Byte 1, RF
       DC      B'11100000'      3 pieces
       DC      B'00000101'      Byte 1, LF
       DC      H'00'
*Initial moves for red
REDM   DC      B'00000111'      3 pieces
       DC      B'00001010'      Byte 2, RB
       DC      B'00001111'      4 pieces
       DC      B'00001011'      Byte 2, LB
       DC      H'00'
*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*      BOARD IMAGE ROUTINE
*
BRDI    LR      K,P     SAVE RETURN
        PI      PUSH
        PI      CLER    TURN OFF CURRENT OBJECTS
        PI      BORD    GENERATE BOARD
        PI      SURP    SET UM1 REGS AND POINTERS
*PUT IN INTIAL PIECES BOTH IN SCRCHPAD
*AND IN BLOCKS 0 OR 1
*
        LISU    PLOC            LOAD SCRATCHPAD AS
        LISL    7               FOLLOWS:
        CLR
BRDJ    LR      D,A             O'30'=FF
        BR7     BRDJ            O'31'=F0
        COM                     O'32'=0
        LR      I,A             O'33'=0
        LR      I,A             O'34'=0
        SL      4               O'35'=0
        LR      I,A             O'36'=F
        LISL    6               O'37'=FF
        LIS     H'F'
        LR      I,A
        LISU    KLOC
        CLR
BRDK    LR      D,A
        BR7     BRDK            O'40'=0
        LISL    4               O'41'=0
        LIS     H'F'            O'42'=0
        SL      4               O'43'=0
        LR      I,A             O'44'=F0'
        LIS     H'4'            O'45'=4
        LR      I,A             O'46'=80
        SL      4               O'47'=0
        SL      1
        LR      I,A
        DCI     RED
        PI      SCRD
        DCI     TREE
        PI      SCRD
        PI      MEN
        PI      POPS
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* Read internal representation of board
* and put pieces in the board image.
*
MEN     LR      K,P             SAVE RETURN ADDRESS
        LISU    3               START WITH PIECES
        LIS     H'1'            1 for red pieces (stored first)
        LR      4,A             Piece color (1 RED, 0 BLACK)
        DCI     COL0
        CLR                     CLEAR ACC
        XM                      IN W/STATUS
        LR      7,A             Save in 7
        LISL    O'7'            Decrement and shift right
        BZ      MEN1            Black active (at bottom of screen)
        LISL    O'0'            Red active  increment and shift left
MEN1    LIS     H'3'
        LR      1,A             To count bytes
        NOP
        NOP
        NOP
        NOP
        BR      MN2A
MEN2    LR      K,P
MN2A    LIS     H'7'
        LR      2,A             To count bits
        DCI     TAB1            Byte location table
        LR      A,1             This byte number
        SL      1               Locations occupy 2 bytes each
        ADC                     
        LM                      Get the byte location
        LR      QU,A            and save it in Q
        LM
        LR      QL,A
        LR      A,7
        NS      7
        BZ      MEN5            Black is active
        LR      A,I             Increment if red is active
        NOP
        NOP
        NOP
        NOP
        BR      MEN4
MEN3    LR      A,3
        SL      1               and shift left
MEN4    LR      3,A
        NI      H'80'           (done this way for symry
        BZ      MEN9
        BR      MEN8
MEN5    LR      A,D             Decrement if black is active
        NOP
        NOP
        NOP
        NOP
        BR      MEN7
MEN6    LR      A,3
        SR      1               and shift right
MEN7    LR      3,A
        NI      H'1'
        BZ      MEN9
MEN8    DCI     TAB2            Relative-locations-of-squares table
        LR      A,2             This square
        ADC
        LM                      Get square displacement
        LR      DC,Q            Recall the location for the input byte
        ADC                     This is the square position
        LR      A,4             Identify type of piece
        NS      4
        BM      PUTK            To put down a king
        LIS     H'4'            Prepare for a piece
        LR      5,A             To count lines
        LI      H'20'           Skip the rst 4 lines (4*8)
        ADC
        XDC
        DCI     BLKP            Anticipate a black piece
        BZ      PUTL            A black piece (status bit still ok)
        DCI     REDP            No, it's a red piece
        BR      PUTL
PUTK    LIS     H'2'            Only 3 lines for a crown
        LR      5,A
        LIS     H'8'            To skip 1 line
        ADC
        XDC
        DCI     KING
PUTL    LM                      Put loop
        XDC
        ST
        LIS     H'7'            To next line on screen (less increment)
        ADC
        XDC
        DS      5
        BP      PUTL            Loop
MEN9    DS      2
        BM      ME10
        LR      A,7
        NS      7
        BZ      MEN6            Black active case
        BR      MEN3            Red active case
ME10    DS      1
        BP      MEN2            For the next input byte
        LR      A,4
        NS      4
        BM      BDEX            Exit from board routine
        DS      4
        BP      MEN1            Go round again for black pieces
        LISU    H'4'            Get set for kings
        LR      A,7
        NS      7
        LISL    H'3'            Decrementing case
        BZ      MEN1
        LISL    H'0'            Incrementing case
        BR      MEN1
BDEX    PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*      BORD GENERATES BOARD IMAGE
*
BORD   LR      K,P
       LI      H'FF'
       LR      3,A     REG3=FF
       DCI     OBJ0    BRD1 START ADDRESS
       LIS     H'2'    FLAG FOR BOR
       LR      4,A     SET REG 4 = 2
       LIS     H'6'
BRD4   LR      0,A     REG0 = 6 ROWS
BRD3   LIS     H'A'
       LR      1,A     REG 1 = 10 LINE/ROW
BRD2   LIS     H'4'
       LR      2,A     REG2=SQ PAIRS/ROW
BRD1   LR      A,3
       ST              STORE IN BRD
       COM
       ST              NEXT IS COMPL. OF FIRST
       DS      2
       BNZ     BRD1    MORE FOR THIS ROW
       DS      1       NO, ALL LINE DONE
       BNZ     BRD2
       LR      A,3     DONE A TIMES YET
       COM
       LR      3,A
       DS      0       DEC ROW COUNT
       BNZ     BRD3    ALL ROWS DONE?
       DS      4
       BZ      BRD5    BOTH OBJECTS DONE?
       DCI     OBJ1    NO,GET BORD2 ADDRS.
       LIS     H'2'
       BR      BRD4    REG0=2
BRD5   PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*    
*      SURP SETS UM1 REGS & PTRS
*
SURP    LR      K,P             SAVE RETURN ADDRESS
        PI      PUSH            AND PUSH IT ONTO STACK
        PI      CLER            CLER UM1 REGISTERS
        DCI     UPI             DCO TO UPDATE CONTROLS
   LIS H'3'
        ST                      SET INTO COUNT
        CLR
        ST                      SET FOR FULL INIT
        LI      INIT:
        ST
        LI      INIT.
        ST                      AND SET ADDRESS
        PI      WAUD            WAIT, THEN UPDATE
        LIS     H'5'
        LR      S,A             GET TRANSFER COUNT
        DCI     BDAT            SET SOURCE
        XDC                     INTO DC1
        DCI     UPI+1           DESTINATION
        PI      TRAN            TRANSFER DATA
        JMP     WAU1            WAIT, DO UPDATE, RESET ISAR&RET.
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
*       UPDATE CONTROL DATA     *
*
BDAT    DC      H'1'            FLAG SET SHORT UPDATE
        DC      UDIT:
        DC      UDIT.
        DC      UDIT:
        DC      UDIT.
*
* Subroutine to move data from RAM to S O'30' thru O'47' with the data f
* S O'30' thru O'43' coming from the current block.  Data for O '44' thr
* O'47' is from the previous block, with some items deleted.
*
NOOP    POP                     DUMMY ROUTINE
*-*-*-*-*-*-*-*-*-*-*-*-*-*
* RA to SC
*
RASC    LR      K,P             Save return address
        PI      PUSH
        LISU    PLOC           ←SC buffer with Active and Passive
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      RASL
        LISU    KLOC            SC buffer with Kings
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      RASL
        LI      H'F1'           Rest of data from earlier block
        ADC
        CLR                     Zero the MOVE byte
        LR      I,A
        LM
        NI      H'E0'           Save Piece debit only
        LR      I,A
        LM
        LR      I,A             Keep both SCORE bytes
        LM
        LR      I,A
        PI      POPS
        PK
*
RASL    LR      K,P
RAS2    LM
        LR      I,A
        DS      0
        BNZ     RAS2
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* moves 16 bytes from SC O'30' thru O'47' to RAM direct.
*
SCRD    LR      K,P
        PI      PUSH
        LISU    PLOC
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      SCRL
        LISU    KLOC
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      SCRL
        PI      POPS
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* Moves 16 bytes from SC O'30' thru O'47' to RAM, reversing
* ACTIVE and PASSIVE and letting some items remain
*
SCRA    LR      K,P
        PI      PUSH
        LISU    PLOC
        LISL    4
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LISU    KLOC
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LR      A,I             To index only
        CLR                     Zero MOVE byte
        ST
        LR      A,I
        NI      H'E0'           Save piece debit only
        LR      A,I
        ST                      Save both SCORE bytes
        LR      A,I
        ST
        PI      POPS
        PK
*
SCRL    LR      K,P
SCR3    LR      A,I
        ST
        DS      0
        BNZ     SCR3
        PK
*
*To compute 4 bytes which show the empty squares on the board and store
*them in O'51' thru O'54' with O'50' and O'55' set to zero as guards.
*Note especially that the EMPTY locations are displaced relative to ACTI
EMPTY   LR      K,P
        LISU    ELOC
        LISL    0
        CLR
        LR      S,A             Make sure guard byte is empty
        LISU    PLOC            Start with ACTIVE
        LIS     H'4'
        LR      0,A
        BR      EMP3
EMP2    LR      A,IS
        AI      H'30'           Actually subtracting 16
        LR      IS,A
EMP3    LR      A,S
        LR      1,A
        LR      A,IS
        AI      4
        LR      IS,A
        LR      A,S
        AS      1
        LR      1,A
        LR      A,IS
        AI      H'D'            Add 13o get to the correct EMPTY locat
        LR      IS,A
        LR      A,1
        COM                     Reverse 1's and 0's
        LR      S,A
        DS      0
        BNZ     EMP2
        CLR
        LR      S,A             Upper guard byte
        PK
*
*Subroutine to count bits in 0 and return count in A
*Uses registers 0 and 1
CAQ     LR      K,P
        CLR
        LR      1,A
        LR      A,0
        BR      CAQ3
CAQ2    DS      1
        AI      H'FF'
        NS      0
        LR      0,A
CAQ3    BNZ     CAQ2
        LR      A,1
        COM
        INC             Make it into a true positive number
        PK
*
*Subroutine to multiply 2 positive binary numbers (the smaller in SC 1 a
*the larger in SC 2) by Russian multiplication.  SC 0 is used to accumul
*the product.  This code may be used at only one place and can probably
*written in line at that place with some saving of space.
*
MPYR    LR      K,P
        CLR
        LR      0,A             To accumulate the product
        LR      A,1
MPY1    NI      H'1'            Is the rightmost bit a 1?
        BZ      MPY2            No
        LR      A,2
        AS      0
        LR      0,A
MPY2    LR      A,2
        SL      1
        LR      2,A
        LR      A,1
        SR      1
        LR      1,A
        BNZ     MPY1            Product is not complete
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
*SET MESSAGE LENGTH&LINE PNTR
*
SEDC   DCI     LINE    DCO TO LINE POINTER
       LIS      H'2'
       SL     4        SET FOR SECOND LINE
       ST
       LR     A,0
       SL     4
       LISL   4
       LR     S,A      AND SET MESSAGE LENGTH
       CLR             CLEAR ACC
       LR     1,A      AND SET DEFAULT RESULT
       POP             N RETURN
*-*-*-*-*-*-*-*-*-*-*-*
*ADDRESS TABLE FOR MVC*
*
TABL   DC      H'0C30'
       DC      H'0C80'
       DC      H'0CD0'
       DC      H'0D20'
       DC      H'0D70'
       DC      H'0DC0'
       DC      H'0F10'
       DC      H'0F60'
*-*-*-*-*-*-*-*-*-*-*-*
*INTERRUPT ENABLE FOR *
*UPDATE DURING COMPUTE*
*OF NEW CHECKER MOVES.*
*
ENIN   LI      INHR:
       OUTS    H'C'
       LI      INHR.
       OUTS    H'D'    SET INTERRUPT VECTOR
       DCI     H'8F0'
       LI      ULIN
       ST              SET INTERRUPT LINE
       DCI     CMRG    DCO TO PROG COPY COMREG
       LR      Q,DC    SAVE ADDRESS IN Q RES
       LIS     H'8'
  OM
       LR      DC,Q
       ST              IN PROGRAM COPY
       DCI     H'8F7'
       ST              DITTO UM1 COPY
       LIS     H'1'
       OUTS    H'E'    ENABLE SMI...
       EI              ENABLE CPU
       LR      J,W     SAVE SAME STATUS
       POP             AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*
*AND ROUTINE TO TURN  *
*THE INTERRUPT OFF.   *
*
DAI    DI              DISABLE CPU INTERRUPT
       LR      J,W     SET J ACCORDINGLY
       DCI     CMRG    DCO TO PROG COPY COMREG
       LR      Q,DC    SAVE ADDRESS
       LIS     H'8'
       COM
       NM              TURN OFF BIT
       LR      DC,Q    IN THE
       ST              PROGRAM COPY,
       DCI     H'8F7'
       ST              AND THE UM1 COPY
       CLR
      OUTS    H'E'    NOW DISABLE SMI
       POP             AND RETURN
*-*-*-*-*-*-*-*-*
*DECLARATIONS
*
VY      EQU     H'2'
VX   EQU  H'1'
X       EQU     H'0'
Y       EQU     HU
*
CON     DCI     COL0    DCO TO COLOR UP FLAG
        CLR             CLEAR ACC
        XM              OR IN W/STATUS
        BP      CON1    BLACK AT TOP
        LR      A,Y     NO. GET Y COORD
        COM
        INC
        AI      H'7'
        LR      Y,A     Y←7-Y
        LR      A,X     GET X COORD
        COM
        INC
        AI      H'7'    X←7-X
        LR      X,A
CON1    DCI     JSAV    DCO TO ENCODED JOYSTICK
        LR      A,Y
        SR      1
        ST              BYTE#←(1/2)*Y
        LIS     H'1'
        NS      X
        LIS     H'8'
        BZ      CON2    X ODD?
        SL      4       YES.
CON2    LR      Y,A     SAVE RESULT IN Y
        LR      A,X     GET X COORDINATE
        SR      1
        LR      X,A     CUT X IN HALF
        LR      A,Y     AND RECOVER BYTE
        BZ      CON4    DONE?
CON3    SR      1       NO, SHIFT BIT OVER
        DS      X       DECREMENT COUNT
        BNZ     CON3    DONE YET?
CON4    ST              YES,STORE RESULT
        POP             AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
* JOYSTICK READ AND MOVE DURING READ
* USES K,DCO,DC1,HU,REGS 0,1,2.
*
CURS    LR      K,P     SAVE RETURN ADDRESS
        PI      PUSH    PUSH IT ON TO STACK
        PI      DAI     DISABLE INTERRUPT DRIVEN UDATE
MAP2    PI      WAUD    WAIT, THEN UPDATE
        LIS     H'8'
MAP3    DCI     H'8FB'  DCO TO CURRENT Y LO
        CM
        BNZ     MAP3    TO START OF DISPLAY
        LIS     H'1'    YES. CAN START JOYREAD
        LR      HU,A    SET FOR HORIZONTAL POT
        PI      JOYI    GET JOYSTICK INPUT
        LR      VX,A    SAVE IN VX
        LIS     H'0'
        LR      HU,A    SET FOR VERTICAL POT
   PI   JOYI
        LR      0,A     SAVE IN REGISTER 0
        PI      AMAP    CONVERT VERTICAL READING
        LR      VY,A    SET IN VY
        LR      A,VX
        LR      0,A
        PI      AMAP    CONVERT HORIZONTAL READING
        LR      VX,A    AND SAVE SAME
        DCI     JPSV    DCO TO SAVE OF LAST POSIT(0-7 COORD)
        LM
        LR      X,A
        LM
        LR      Y,A     SET X & Y FROM OLD READING
        LIS     H'8'
        LR      3,A     SET COUNTER
MAP4    LR      A,X     GET X COORD
        AS      VX      ADD VX TO GET "NEW" POSITION
        BP      MAP5    OFF LHS?
        LIS     H'0'    YES, RESET
        BR      MAP6
MAP5    CI      H'7'
        BC      MAP6    OFF RHS?
        LIS     H'7'    YES, RESET
MAP6    LR      X,A     SET NEW X COORD
        LR      A,Y     GET Y COORD
        AS      VY      ADD VY FOR "NEW" POSITION
        BP      MAP7    OFF THE TOP?
        LIS     H'0'    YES, RESET TO TOP
        BR      MAP8
MAP7    CI      H'7'
        BC      MAP8    OFF THE BOTTOM?
        LIS     H'7'    YES, RESET
MAP8    LR      Y,A     SET NEW Y VALUE
        AS      X       ADD X COORD
        NI      H'1'
        BNZ     MAP9    LEGAL SQAURE?
        DS      3       NO, DECREMNT COUNTER
        BNZ     MAP4    TRIED TWICE?
        BR      MP12    YES, LEAVE CURSOR ALONE
MAP9    PI      MVC     DELETE OLD POSITION
        DCI     JPSV
        LR      A,X
        ST
        LR      A,Y
        ST              RESET POSITION
        PI      MVC     AND DISPLAY IT
MP12    LI      H'1E'
        LR      3,A     SET TIMER COUNT
MP10    CLR             CLEAR ACC
        OUTS    1       CLEAR TO PORT 1
        NOP             NOPS FOR FCC
        NOP             REASONS.
        NOP             DO NOT REMOVE!!!
        INS     1
        NI      H'1'
        BNZ     MP11    BUTTON PRESSED?
        PI      WAUD    NO, WAT THEN UPDATE
        DS      3       DECREMENT COUNTER
        BNZ     MP10    WAITED LONG ENOUGH?
        BR      MAP2    YES, CHECK JOYSTICK AGAIN
MP11    PI      CON     BUTTON PRESSED SO, CONVERT
        DCI     JSAV    DCO TO JOYSTICK CONVERTED VALS
        LM
        LR      4,A     BYTE NUMBER IN R4
        LM
        LR      3,A     BYTE IN R3
        DCI     JPSV    DCO TO 0-7 FORM OF COORDS
        LM              GET X COORD
        LR      1,A     STORE IN R1
        LM              GET Y COORD
        LR      2,A     STORE IN R2
        DCI     COL0    DCO TO COLOR
        CLR             CLEAR ACC
        XM              IN, W/STATUS
        BP      MP13    BLACK IS PLAYER?
        LR      A,2     YES
        COM
        INC
        AI      H'7'    Y←7-Y
        LR      2,A
        BR      MP14
MP13    LR      A,1     PLAYER RED
        COM
        INC
        AI      H'7'
        LR      1,A     X←7-X
MP14    PI      WAUD    WAIT, THEN UPDATE
        PI      ENIN    ENABLE INTERRUPTS
        PI      POPS    POP RETURN ADDRESS
        PK              AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
* SET CURSOR ON DISPLAY, OR REMOVE
*USES REGISTERS 1, Q, DCO
*
MVC     LR      K,P     SAVE RETURN ADDRESS
        DCI     JPSV    DCO TO COORDINATE (0-7 FORM)
        LM
        LR      1,A     SAVE IN R1
        LM
        SL      1       ACC←2*Y
        DCI     TABL
        ADC             ADD OFFSET TO ADDR TABLE
        LM
        LR      QU,A
        LM
        LR      QL,A    SET BASE ADDRESS IN Q
        LR      DC,Q    AND INTO DCO
        LR      A,1     GET X COORD
        ADC             ADD OFFSET FOR SAME
        LIS     H'4'
        LR      1,A     SET COUNTER
        XDC
        DCI     POIN    DCO TO CURSOR OBJ
MVC1    LM
        XDC
        LR      Q,DC
        XM
        LR      DC,Q
        ST
        LIS     H'7'    NEXT DESTINATION
        ADC             IN DCO
        XDC             AND SAVED IN DC1
        DS      1       DONE ALL?
        BNZ     MVC1
        PK              YES, RETURN
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* JOYSTICK MAPPING ROUTINE
*USES ACC, R0, AND W
*
AMAP    LR      A,0     GET VALUE TO BE CONVERTED
        CI      H'10'
        BNC     AMP1    VAL LE H'40'?
        LI      H'FF'   YES, SET VELOCITY TO -1
        BR      AMP2
AMP1    CI      H'B7'
        LIS     H'1'
        BNC     AMP2    VALUE GT H'B7'?
        CLR             NO, SO VELOCITY IS 0
AMP2    POP
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* WRITE MESSAGE, CHECKERS
*MESSAGE NUMBER IN REGISTER 0
*USES R0, SP O'24', AND THOSE REGISTERS
*USED BY THE UPDATE ROUTINE
*
WMC     LR      K,P     SAVE RETURN ADDRESS
        PI      PUSH    PUSH ONTO STACK
        PI      DAI     DISABLE INTERRUPTS
        PI      WAUD    WAIT, THEN UPDATE
        DCI     WMCA    DCO TO MESSAGE ADDRESS START
        LR      A,0     GET MESSAGE NUMBER
        SL      1
        AS      0
        ADC             ADD 3XNUMBER TO DCO
        LISU    2
        LISL    4       SET ISAR TO O'24'
        LM
        LR      S,A     SET MESSAGE LENGTH
        LM
        LR      QU,A
        LM
        LR      QL,A    MESSAGE ADDRESS INTO Q
        DCI     LINE
        LI      H'50'
        ST              SET PROPER LINE NUMBER
        DCI     H'0E5F' DCO TO MESSAGE BUILD AREA
        LI      H'70'
        LR      0,A     SET COUNTER
        CLR             CLEAR ACC
WMC1    ST
        DS      0
        BNZ     WMC1    CLEAR TEXT AREA
        PI      WAUD    WAIT, THEN DO UPDATE
        DCI     H'872'
        LIS     H'2'
        ST              TURN OBJECT ON
        LR      DC,Q    SET ADDRESS INTO DCO
        PI      WMS     WRITE MESSAGE
        PI      WAUD    WAIT, THEN UPDATE
        PI      ENIN    ENABLE INTERRUPTS ONCE MORE
        PI      POPS    POP RETURN ADDRESS
        PK              AND RETURN
*-*-*-*-*-*-*-*-*-*
* DATA FOR WMC
*
WMCA    DC      H'A'    YOUR MOVE!      0
        DC      YRMV:       
        DC      YRMV.
        DC      H'A'    MUST JUMP       1
        DC      MJM:
        DC      MJM.
        DC      H'D'    ILLEGAL MOVE    2
        DC      MIM:
        DC      MIM.
        DC      H'8'    TOO FAR         3
        DC      TFM:
        DC      TFM.
        DC      H'10'   WRONG DIRECTION    4
        DC      WDM:
        DC      WDM.
        DC      H'10'   PIECE CANNOT MOVE  5
        DC      PCMM:
        DC      PCMM.
YRMV    DC      H'0513' YO
        DC      H'0309' UR
        DC      H'0'    SPACE
        DC      H'2913' MO
        DC      H'2F0B' VE
        DC      H'04'   !
MJM     DC      H'290B' MU
        DC      H'2107' ST
        DC      H'0'    SPACE
        DC      H'1703' JU
        DC      H'2925' MP
        DC      H'04'   !
MIM     DC      H'0127' IL
        DC      H'270B' LE
        DC      H'1B11' GA
        DC      H'2700' L SPACE
        DC      H'2913' MO
        DC      H'2F0B' VE
        DC      H'04'   !
TFM     DC      H'0713' TO
        DC      H'1300' O SPACE
        DC      H'1D11' FA
        DC      H'0904' R!
WDM     DC      H'0D09' WR
        DC      H'132B' ON
        DC      H'1B00' G SPACE
        DC      H'1F01' DI
        DC      H'090B' RE
        DC      H'3107' CT
        DC      H'0113' IO
        DC      H'2B04' N!
PCMM    DC      H'2501' PI
        DC      H'0B31' EC
        DC      H'0B00' E SPACE
        DC      H'3111' CA
        DC      H'2B39' N'
        DC      H'0700' T SPACE
        DC      H'2913' MO
        DC      H'2F0B' VE
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
* DEBUGGING AID ROUTINE.  NOT TO REMAIN
* IN CHECKERS PROGRAM AFTER DEBUGGING 
* COMPLETED
* DESTROYS THE CONTENTS OF Q REGISTERS
*
DBUG    LR      K,P     SAVE RETURN ADDRESS
        LR      Q,DC    SAVE DCO IN Q REGISTER
        DCI     H'1FB9' DCO TO START OF SAVE AREA
        LR      QU,A
        ST
        LR      QL,A
        ST              SAVE OLD DCO
        XDC
        LR      Q,DC
        XDC
        LR      A,QU
        ST
        LR      A,QL
        ST              SAVE OLD DC1
        LR      A,9     GET J REGISTER
        ST              AND SAVE IT
        LR      J,W
        LR      A,9
        ST              AND SAVE STATUS
        LR      A,IS
        ST              NOW SAVE THE ISAR
        LI      H'40'
        LR      9,A     SET COUNTER
        CLR
        LR      IS,A    AND SET ISAR
DBG1    LR      A,S
        ST
        LR      A,IS
        INC
        LR      IS,A
        DS      9
        BNZ     DBG1    SAVED ALL OF SCRATCHPAD?
        PI      PUSH    YES, PUSH RETURN ADDRESS
        PI      DAI     AND DISABLE INTERRUPTS
        PI      WAUD    WAIT, THEN UPDATE
    DCI    H'822'
        LI      H'63'
        ST              DELTAX OBJ2←3
        DCI     H'FFC'
        LI      DBDT:
        ST
        LI      DBDT.
        ST
        LI      DBDT:
        ST
        LI      DBDT.
        ST              RESET UPDATE DATA POINTERS
        DCI     H'872'
        LIS     H'2'
        ST              TURN OBJECT ON...
DBG2    PI      WAUD    WAIT, THEN UPDATE
        CLR
        OUTS    1       CLEAR PORT 1
        NOP             NOPS FOR FCC
        NOP             RELATED REASONS.
        NOP             DO NOT DELETE!!!
        INS     1
        NI      H'1'
        BZ      DBG2    BUTTON PRESSED
        DCI     H'872'  YES, TURN
        LI      H'82'   OBJECT 2 OFF
        ST
    DCI  H'822'
        LI      H'6F'
        ST              RESET OBJ 2 DELTA X
        DCI     H'FFC'
        LI      UDIT:
        ST
        LI      UDIT.
        ST
        LI      UDIT:
        ST
        LI      UDIT.
        ST              RESET UPDATE POINTERS
        PI      WAUD    DO ONE MORE UPDATE
        PI      ENIN    RE-ENABLE INTERRUPTS
        PI      POPS    POP RETURN ADDRESS
        PK              AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*-
*DATA FOR DEBUG ROUTINE
*
DBDT    DC      H'30'   ROM LO
        DC      H'10'
        DC      DBGO.
        DC      H'8C'   ROM HO + COLOR
        DC      H'8F'
        DC      DBGO:+H'E0'
        DC      H'3C'   DELTA Y
        DC      H'14'
        DC      H'05'
*-*-*-*-*-*-*-*-*-*-*-*-
*DEBUG OBJECT FOR TEST
*
DBGO    DC      H'F772'
        DC      H'5E54'
        DC      H'4A50'
        DC      H'5672'
        DC      H'5654'
        DC      H'4A52'
        DC      H'F77B'
        DC      H'DE'
*
CTMP  LR  K,P
    PI  PUSH
    PI  DAI
CTM1  PI  WAUD
    CLR
    OUTS 1
    INS  1
    NI   H'1'
    BZ  CTM1
    NOP
    NOP
    NOP
    NOP
    LI   H'0'
    LR   1,A
    LI   H'0'
    LR   2,A
        LI   H'0'
    LR   3,A
    LI   H'0'
    LR   4,A
    PI   WAUD
    PI   ENIN
    PI   POPS
    PK
       ORG     H'1680'
*
*-*-*-*-*-*-*-*-*-*
*   INHR  INTERRUPT HANDLER
*
*   STORES ENVIRONMENT BEFORE CALLING UDAT
*   AND RESTORES BEFORE GOING BACK'
*
INHR   LR      8,A     SAVE ACC
       LR      A,IS
       LISU    O'6'
       LISL    O'0'
       LR      I,A     SAVE A IN REG24
       LR      A,QU
       LR      I,A     SAVE QU IN REG25
       LR      A,QL
       LR      I,A     SAVE QL IN REG26
       LR      A,J
       LR      I,A     SAV IN REG27
       XDC
       LR      Q,DC    GET DC
       DCI     H'0FB0' GET FREE RAM ADDR.
       LR      A,QU    SAVE ORIGINAL DC1
       ST
       LR      A,QL
       ST
       XDC
       LR      Q,DC
       XDC
       LR      A,KU
       ST
       LR      A,KL
       ST              SAVE KL
       LR      A,10    UPPER H
       ST              SAVE IT
       LR      A,11
       ST              SAVE H
       LR      J,W
       LR      A,J
       ST              SAVE W
       LR      K,P
       LR      A,KU
       ST              SAVE PCU
       LR      A,KL
       ST              SAVE PCL
       LR      A,QU    SAVE DC0 ORIGINAL
       ST
       LR      A,QL
       ST
       PI      UDAT    UPTE DISPLAY
*
*   RESTORE ALL REGISTERS
*
       DCI     H'0FB0'
       LM
       LR      QU,A    GET DC1
       LM
       LR      QL,A
       XDC
       LR      DC,Q    RESTORE DC1
       XDC
       LIS     H'2'
       ADC             BYPASS 'K' SAVED AREA
       LM              GET HU
       LR      HU,A    RESTORE HU
       LM
       LR      HL,A    RESTORE HL
       LM              GET W
       LR      J,A
       LR      W,J     RESTORE IT
       LM              GET PC1 HO
       LR      KU,A
       LM
       LR      KL,A
       LR      P,K     RESTORE PC1
       LM
       LR      QU,A
       LM
       LR      QL,A
       DCI     H'FB2'        PT TO K
       LM              GET KU
       LR      KU,A
       LM
       LR      KL,A    RESTORE K
       LR      DC,Q    RESTORE DC0
*
*   NOW RESTORE J,Q,A FROM SCRATCH PAD
*
       LISU    O'6'
       LISL    O'3'
       LR      A,D     GET J
       LR      J,A
       LR      A,D   GET QL
       LR      QL,A
       LR      A,D
       LR      QU,A    RESTORE QU
       LR      A,D     GET ISAR
       LR      IS,A    RESTORE ISAR
       LR      A,8     RESTORE A
       EI              INT. ENABLE
       POP
*   DISAY YOU MOVE FIRST?
*             Y OR N
*
*
YMF    DC      H'0513' Y0
       DC      H'0300' U-
       DC      H'2913' MO
       DC      H'2F0B' VE
       DC      H'00'   -
       DC      H'1D'   F
       DC      H'0109' IR
       DC      H'2107' ST
       DC      H'00'   -
       DC      H'35'   ?
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'0500' Y-
       DC      H'1309' OR
       DC      H'00'   -
       DC      H'2B'   N
*   INIT  DATA
INIT   DC      H'30'   OBJ0 L.O.RP
       DC      H'10'   OBJ1 L.O. RP
        DC      H'5F'   TEXT LOW ORDER ROM
       DC      H'8C'   OBJ0 H.O.RP+COLOR
       DC      H'8F'   OBJ1    H.O.RP
        DC      H'EE'   
       DC      H'48'   OBJ0 DELTA X ---
       DC      H'48'   OBJ1 DELTA X---
       DC      H'70'   TEXT OBJECT DELTA X
TY0   DC      H'3C'   OBJ0 DELTA Y ----
       DC      H'14'  OBJ1 DELTA Y ---
       DC      H'07'  TEXT OBJECT DELTA Y
       DC      H'0D'   OBJ0-X-CO
       DC      H'0D'   OBJ1 X-CO
       DC      H'0D'   TEXT OBJECT X COORD
       DC      H'48'   OBJ0 Y-VALUE L.O.A
       DC      H'C0'   OBJ1 Y-VALUE L.O.A
       DC      H'25'   TEXT OBJECT Y VAL LO A
       DC      H'00'   OBJ0 Y-VALUE H.0 &X-ORDER
       DC      H'01'   OBJ1- Y-VAL H.O.$X-ORDER
       DC      H'82'   TEXT OBJ INITIALLY OFF
UDIT   DC      H'30'
       DC      H'10'
       DC      H'5F'
       DC      H'8C'
       DC      H'8F'
       DC      H'EE'
        DC      H'3C'
        DC      H'14'
        DC      H'07'
TAB1   DC      H'0F10' BYTE 3
       DC      H'0D70' BYTE 2
       DC      H'0CD0' BYTE 1
       DC      H'0C30' BYTE 0
TAB2   DC    D'86'   RELATIVE SQUARE POSITION TABLE
       DC      D'84'
       DC      D'82'
       DC      D'80'
       DC      D'07'
       DC      D'05'
       DC      D'03'
       DC      D'01'
KING   DC      B'011010'     KING'S CROWN
       DC      B'00111100'
       DC      B'00011000'
REDP   DC      B'00111100'     RED PIECE
       DC      B'01111110'
       DC      B'01111110'
       DC      B'01111110'
       DC      B'00111100'
BLKP   DC      B'00111100'     BLACK PIECE
       DC      B'01000010'
       DC      B'01000010'
       DC      B'01000010'
       DC      B'00111100'
POIN   DC      B'00001100'
       DC      B'00000110'
       DC      B'00000011'
       DC      B'00000001'
*-*-*-*-*-*-*-*-*-*-*-*-*-
*   SKILL LEVEL TEXT TABLE
*
SKL    DC      H'3119' CH
       DC      H'1313' OO
       DC      H'210B' SE
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'150B' KE
       DC      H'0500' Y-
       DC      H'00'   -
       DC      H'00'   -
       DC      H'0713' TO
       DC      H'2900' M-
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'07'   T
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
DICK   DC      H'1F01' DI
       DC      H'3115' CK
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'1F'   D
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
HARY   DC      H'1911' HA
       DC      H'0909' RR
       DC      H'0500' Y-
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'19'   H
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
* FKT  GMEN  RFJN  LFJN  STMV
*-*-*-*-*-*-*-*-*-*-*-*-*-
* limits pieces to KINGS depending on direction and color
*
FKT     LR      K,P
        CLR
        AS      7
        BR      FK1
BKT     LR      K,P
        LR      A,7             Test sides for backward move
        COM
FK1     BZ      FK2             NORMAL pieces can move
        LISU    KLOC            KINGS only can move
        LR      A,S
        NS      3
        LR      3,A
        BZ      FK3             No RF OR LF moves from this byte
FK2     LR      A,3
        NS      3               To set status
FK3     PK
*
FJET    LR      K,P
        LIS     H'1'
        BR      BJE2
BJET    LR      K,P
        LI      H'FF'
BJE2    AS      4
        AI      ISE
        LR      IS,A
        LR      A,S
        PK
*
*Subroutine to get byte of ACTIVE pieces
GMEN    LR      K,P
        LR      A,4
        AI      ISA             Start of active area
        LR      IS,A
        LR      5,A             Save it here temporarily
        LR      A,6
        CI      H'7'            Is this an attempted continuation?
        BZ      GME2            Yes, 3 is already set
        CI      H'1'            Maybe back up to test for forked continuation
        BZ      GME2
        LR      A,S
        LR      3,A
GME2    PK
*
*Subroutine used both by RFJ and RFN
RFJN    LR      K,P
        LR      A,I
        SL      4
        LR      0,A
        LR      A,S
        SR      4
        SR      1
        AS      0
        NS      3
        LR      3,A             The RFJ or RJ byte
        PK
*
*Subroutine used both by LFJ and LFN
LFJN    LR      K,P
        LR      A,I
        SL      4
        SL      1
        LR      0,A
        LR      A,S
        SR      4
        AS      0
        NS      3
        LR      3,A             The LFJ or LFN byte
        PK
*
*Subroutine used both by LBJ and LBN
LBJN    LR      K,P
        LR      A,D
        SL      4
        LR      0,A
        LR      A,S
        SR      4
        SR      1
        AS      0
        NS      3
        LR      3,A
        PK
*
*Subroutine used both by RBJ and RBN
RBJN    LR      K,P
        LR      A,D
        SL      4
        SL      1
        LR      0,A
        LR      A,S
        SR      4
        AS      0
        NS      3
        LR      3,A
        PK
*Subroutine to add to MOBILITY, and to store MOVE and FLAG bytes if necessary
STMV    LR      K,P
        LISU    KLOC
        LISL    4               To MOVE byte
        LR      A,3             GET newly computed MOVE byte
        LR      0,A
        PI      CAQ             Count its bits
        AS      2               Add earlier counts
        LR      2,A             and store
        LR      A,11
        SR      4
        CI      H'01'           Is this the player's board
        BNZ     STM3            No
        DCI     PLMV            Player's moves stored separately
STM0    LM
        NI      H'FF'
        BZ      STM1            Find empty space
        LM                      Skip info space
        BR      STM0            Try again
STM1    LI      H'FF'           Back up
        ADC
        LR      A,3
        ST
        LR      A,4
        SL      1
        SL      1
        AS      5
        ST
        CLR
        ST                      Store 0 as stop
        PK
STM3    LR      A,S             Has a move byte been stored?
        NS      S               To set status byte
        BNZ     STM2            One is already stored
        LR      DC,H            Get back in step (may not be necessary)
        LIS     H'C'            To get to MOVE byte
        ADC
STM4    LR      A,3
        ST                      Store MOVE byte in RAM
        LR      I,A             Also put it in SC record as a flag
        LR      A,4             Get the byte pointer
        SL      1
        SL      1
        AS      5
        ST                      Put this into RAM
        LR      DC,H            May be necessary
STM2    PK
* NEXT  FIND  RFJ  LFJ  RBJ  LBJ
*
NEXT    CLR
        LR      6,A             Set for normal back up
        LR      DC,H
        LIS     H'D'            Get to byte number info
        ADC
        LR      A,11            Check for multiple jump condition
        SR      4
        AI      H'FD'           1 for start offset, 2 ply's Mobs. not saved
        BM      NEX2            Can not be a continuation
        XDC                     Save location
        DCI     MOBS
        ADC
        LM
        NI      H'7'            Is flag set?
        XDC
        BZ      NEX2            No multiple jump
*The moving piece byte and byte number is stored in the next earlier block
        XDC
        LR      DC,H
        LI      H'FC'           Back up to get info
        ADC
        LM
        LR      3,A             The byte with 1 bit on
        LM
        LR      4,A             The byte number
        XDC                     Now back again to the current block
        LIS     H'1'            The signal read by GMEN
        LR      6,A             Overwrite previously set value
NEX2    LM                      Get identifying data
        LR      0,A             Save temporarily
        NI      H'F'            Leave J bit and other data off
        CI      H'F'            Is this the last move byte?
        BZ      NEX5            Yes
        LR      A,0
        INC                     To next  direction
        LR      0,A
        SR      1
        SR      1
        NI      3
        LR      4,A             Save byte number
        LR      A,0             Now get the direction
        NI      3               Separate out desired data
        LR      5,A             And save  (it will be a 1, 2, or 3)
        LR      A,0
        NI      H'10'           Check jump bit
        BNZ     NEX4            A jump move
        LR      A,5
        NS      5
        BZ      NEX3
        JMP     RBN0            A normal move, decide on 1, 2, or 3 later
NEX3    JMP     RFN             It was 0
NEX5    JMP     AFT
NEX4    LR      A,5
        NS      5
        BZ      RFJ             It was a 0
        CI      H'2'            Which direction, 1, 2, or 3?
        BM      LBJ             It was a 3
        BNZ     LFJ             It was a 1
        BR      RBJ             It was a 2
*We enter here on going forward
FIND    LISU    PLOC
        LISL    0               Start with byte 0
        CLR
        LR      4,A             Used to distinguish byte
        LR      2,A             Used to accumulate mobility count by STMV
        LI      H'FF'
        LR      6,A             So all moves will be found
RFJ     PI      GMEN
        PI      FKT             Are there forward moving pieces?
        PI      FJET            Are jump moves in this direction posible?
        SR      1
        NI      H'77'           Save 6 particular bits only
        NS      3
        LR      3,A             Only pieces that have place to land
        LR      A,4             Get byte number
        AI      ISP             Start of passive area
        LR      IS,A
        PI      RFJN            This returns the RFJ byte in 3 and sets STATUS
        BZ      LFJ
        LI      H'10'           The RFJ direction and J indicator
        LR      5,A
        PI      STMV            Store MOVE and FLAG if MOVE found
        BR      JUMF
LFJ     PI      GMEN
        PI      FKT
        PI      FJET            Are jump moves in this direction posible?
        SL      1
        NI      H'EE'           Save 6 particular bits only
        NS      3
        LR      3,A             Only pieces that have a place to land
        LR      A,4             Get byte number
        AI      ISP             Start of passive area
        LR      IS,A
        PI      LFJN            This returns the LFJ byte in 3
        BZ      RBJ
        LI      H'11'           The LFJ direction and J indicator
        LR      5,A
        PI      STMV
        BR      JUMF
RBJ0    LR      A,5
        CI      H'2'            Which direction, 1, 2, or 3?
        BM      LBJ             It was a 3
        BNZ     LFJ             It was a 1
RBJ     PI      GMEN
        PI      BKT
        PI      BJET
        SR      1
        NI      H'77'           Save 6 particular bits only
        NS      3
        LR      3,A
        LR      A,4             Get byte number
        AI      ISP             Start of passive area
        LR      IS,A
        PI      RBJN            This returns the RBJ byte in 3
        BZ      LBJ
        LI      H'12'           The RBJ direction and J indicator
        LR      5,A
        PI      STMV
        BR      JUMF
LBJ     PI      GMEN
        PI      BKT
        PI      BJET
        SL      1
        NI      H'EE'           Save 6 particular bits only
        NS      3
        LR      3,A
        LR      A,4             Get byte number
        AI      ISP             Start of passive area
        LR      IS,A
        PI      LBJN            This returns the RBJ byte in 3
        BZ      JUMT
        LI      H'13'           The RBJ direction and J indicator
        LR      5,A
        PI      STMV
JUMF    LR      A,11            Where are we?
        SR      4               To get the ply
        CI      H'1'            Remember offset
        BNZ     JUMD
        JMP     PMRT            Check players move for validity
JUMD    CI      H'F'            Are we out of space? (next block contains MOBS)
        BZ      RFN             To compute non-jump mobility and stop anyway
        LR      DC,H
        JMP     SELE
* JUMT AFTC
*
*No move found from this byte so see if there are more bytes
JUMT    LR      A,6
*Are we backing up and then trying to find yet another continuation?
        CI      H'1'            Are we backing up to a possible fork
        BZ      AFTC            Yes so something special is required
        CI      H'7'            Were we trying to find a continuation
        BNZ     JUMM            No
        LR      DC,H            There was no continuation
        LI      H'F0'           Back up
        ADC
        LR      H,DC
        JMP     DOUX            This changes the color and proceeds
JUMM    LR      A,4
        INC
        NI      H'3'
        LR      4,A
        BNZ     RFJ             Go round again for next byte
        LR      A,6
        XI      H'FF'
        CLR
        LR      4,A             Prepare to start over on the first byte
        BZ      RFN             Maybe there are normal moves
        JMP     AFT             A jump was demanded so back up
*We compare the score with that 2 blocks earlier and back it up if greater
*and then back to this level in any case
AFTC    LR      DC,H            We are here
        LIS     H'E'            Get score values
        ADC
        LM
        LR      0,A             Save them to complare
        LM
        LR      1,A
        LI      H'D0'           Actually backing only 2
        ADC
        LR      H,DC            We back up always
        LIS     H'E'            Get to score location
        ADC
        LR      A,0             Now compare score
        CM
        BM      AFT2            Back score for sure
        BNZ     AFT5            Do not back score
        LR      A,1             A further comparison is necessary
        CM
        BP      AFT5            Do not back after all
AFT2    LR      DC,H            Resetting is easier
        LIS     H'E'
        ADC
        LR      A,0             Back up the score
        ST
        LR      A,1
        ST
        LR      A,11            Where are we?
        SR      4
        CI      H'3'            Do we need to save board as possible move?
        BNZ     AFT5            No, at some other level in the tree
        LR      A,0             Invert score for compaarison
        COM
        INC
        LR      0,A
        LR      A,1             Invert score
        COM
        INC
        LR      1,A
        LR      DC,H
        LI      H'FE'           Back to earlies score
        ADC
        LR      A,0
        CM
        BM      AFT3            Board should be saved
        BNZ     AFT5            It should not be saved
        LR      A,1
        CM
        BP      AFT5            Don't save after all
*Special treatment is necessary to prevent the saving of the
*intermediate board position of the multiple jump at a later time
*We do this by backing the score now
AFT3    LR      DC,H
        LI      H'FE'
        ADC
        LR      A,0             First back score now
        ST
        LR      A,1
        ST
        DCI     TREE            Location to save board
        XDC
*
*NOTE: This is fixwd for a double jump but some additional code
*may still needed for a triple jump!
*
        LR      DC,H
        LI      H'10'           Double jump resulting board
        ADC
        LR      0,A             Counter
AFT4    LM                      Now save the board
        XDC
        ST
        XDC
        DS      0
        BNZ     AFT4
        LR      DC,H            Reset
AFT5    JMP     SELE
* AFT MAKE OKMV PMRT
*
*No moves found so time to back up
AFT     LR      DC,H
        LIS     H'E'            Get to SCORE
        ADC
        LM
        LR      0,A             The current material advantage term
        LM
        LR      6,A             The current positional term
        LR      A,11            Where are we?
        SR      4
        CI      H'2'
        BZ      MAKE            Time to report move
        CI      H'3'            Room to alpha-beta prune?
        BP      AFTX            No
        LR      DC,H
        LI      H'EE'           The score for 2 boards earlier
        ADC
        JMP     EV4A
AFTX    JMP     EVA5
*
*Prepare for analysis of player's reply
MAKE    DCI     TREE            Get to players board
        LR      H,DC
        XDC                     Now clear space for possible players moves
        DCI     PLMV            This space is also used by TREE routine
        LIS     H'F'
        LR      0,A
        CLR
        ST
        DS      0
        BP      *-2
        XDC
        PI      RASC            Put board into SC
        JMP     FIND
*Subroutine to save players possible moves
SVPM    LR      K,P
        XDC                     So we can get back
        LR      A,5
        NI      H'10'
        DCI     PLMF            Players jump move flag
        ST
        LR      A,4
        SL      1
        SL      1
        AS      5
        NI      H'F'            Save only last 4 bits
        DCI     PLMV            This area may be overwritten by tree info.
        ADC
        LR      A,3
        ST
        XDC
        PK
PMRT    NOP                     Player's possible moves have been listed
*We are ready to display the new board
*-*- DISPLAY CODE GOES IN HERE

*We are ready to verify players move
OKIT    DCI     PLMV            Location where players move began
*-*- INIT JOYSTICK and wait for players indication that he has picked
*-*piece to move then go to OKPI and then to OKMV
* RFN LFN RBN LBN NORT NORF NOR2 NOR3 NOR4
*
RFN     PI      GMEN
        PI      FKT
        BZ      RBN
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      RFJN
        BZ      LFN
        CLR
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BNZ     NORF
LFN     PI      GMEN
        PI      FKT
        BZ      RBN
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      LFJN
        BZ      RBN
        LIS     H'1'
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BNZ     NORF
        BR      RBN
RBN0    LR      A,5
        CI      H'2'            Which direction, 1, 2, or 3?
        BM      LBN             It was a 3
        BNZ     LFN             It was a 1
RBN     PI      GMEN
        PI      BKT
        BZ      NORT
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      RBJN
        BZ      NORT
        LIS     H'2'
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BNZ     NORF
LBN     PI      GMEN
        PI      BKT
        BZ      NORT
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      LBJN
        BZ      NORT
        LIS     H'3'
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BZ      NORT
NORF    JMP     SELE
*We get here if we want to compute mobility and also if no moves found
NORT    LR      A,4
        INC
        NI      H'3'
        LR      4,A
        BNZ     RFN             Go round again for next byte
        LR      A,2             Get mobility count
        NS      2
        BNZ     NOR1
        JMP     AFT             Woops! no move found
NOR1    LR      A,11            Where are we?
        SR      4               Get Ply number
        AI      H'FF'
        LR      3,A
        BNZ     NOR2
        JMP     PMRT            Ckeck players move for validity
NOR2    DCI     PLY0            Player's choice of ply
        CM
        LR      DC,H            Reset DC
        BM      NOR3            Stop for sure
        BNZ     NOR4            Go on in this case
        LI      H'F5'           Decision based on previous move
        ADC
        LM
        NI      H'10'           Test jump flag
        LR      DC,H
        BNZ     NOR4            Go on if previous move was a jump
NOR3    JMP     EVAL
NOR4    LR      A,3
NOR5    AI      H'FD'           To save space so MOBS will not overflow
        BM      NOR7            Don't save mobility for early plys
        DCI     MOBS
        ADC
        LR      A,2
        CI      H'F'            Limit mobility to 15 so it will pack
        BP      NOR6
        LIS     H'F'
NOR6    SL      4               Reserve right half for Multiple jump flags
        ST                      Save mobility in MOBS space indexed by ply
NOR7    LR      DC,H            Get back in step
        JMP     SELE
* SELECT  SELE
*
*SELECT branches to NEXT if MOVE is empty, or it extracts the rightmost
*bit from the MOVE byte in RAM, storing the extracted bit in SC 6, puts the
*FLAG byte in SC 7, the byte number in 4, and the J and direction bits in 5.
*and proceeds to make the selected move.
SELE    LR      DC,H            Load DC  with starting location for current ply
        PI      RASC            Get board data into Scratchpad
SEL2    LR      DC,H
        LIS     H'C'            To get MOVE byte
        ADC
        LM
        LR      0,A             Save it temporarily
        NS      0               To set status byte
        BNZ     SEL3
        JMP     NEXT            To get next MOVE byte
SEL3    LI      H'FF'
        ADC                     Get back to move byte
        LR      A,0
        AI      H'FF'           Really subtracting 1
        NS      0               Remove right-most on-bit
        ST                      Put remaining bits back (and index)
        XS      0               This gets the extracted bit
        LR      6,A             Save it in 6
*-*- A record of the serial number of this move should be kept for ply 0
*-*- and put with the resulting board, for use in identifying path for book moves.
        LM                      Now get the byte designation
SEL4    LR      5,A
        SR      1
        SR      1
        NI      H'3'            Separate the byte indicator part
        LR      4,A             Save it in 4
        LR      A,5
        NI      H'13'           Separate the JUMP bit and the direction
        LR      5,A             Save them in 5
*Now process ACTIVE and KINGS for source deletion
DELE    PI      GMEN
        XS      6               Delete moving piece
        LR      S,A             from byte
        LISU    KLOC            To get to corresponding KING byte
        LR      A,S
        NS      6               Was the piece a king?
        BZ      DEL2
        XS      S               If it was delete king bit
        LR      S,A
        LIS     H'7'            Non-zero in 2 for king 
DEL2    LR      2,A             Save as a flag for kind of piece moving
*Now locate captured piece if jump or find destination in normal move
        LR      A,6             Recall MOVE bit
        SR      4
        BZ      INRH            Bit was in right half of byte
INLH    LR      3,A             Save partially shifted MOVE bit
        LR      A,5             Get direction
        NI      H'1'            To test right-most bit
        BZ      INL2            RF or LB move where 4 shift is correct
        LR      A,3
        SR      1               LF and LB require an additional shift
        LR      3,A
INL2    LR      A,5             Now test for fore or aft
        NI      H'2'
        BZ      BOTH            Forward move, no byte shift needed
        LR      A,D             Only to decrement ISAR
INL3    BR      BOTH
*
INRH    LR      A,6             Get MOVE bit again
        SL      4               Left shift if in right half
        LR      3,A             Save partially shifted MOVE bit
        LR      A,5             Get direction
        NI      H'1'
        BNZ     INR2            LF or RB wwhere 4 shift is correct
        LR      A,3
        SL      1               RF and RB require an additional shift
        LR      3,A
INR2    LR      A,5             Now test fore and aft
        NI      H'2'
        BNZ     BOTH
        LR      A,I             Only to increment ISAR
*Now we are ready to decide if jump or not
BOTH    CLR
        LR      0,A             Used temporarily to accumulate piece debit
        LR      A,5             Now is this a jump or a normal move?
        SR      4
        BNZ     BOT1
        JMP     NORM            It's a normal move
BOT1    JMP     JUMP
* JUMP
*
JUMP    LR      A,S             Get King Byte corresponding to captured piece
        NS      3               Was piece a king?
        BZ      JUM1            No
        XS      3               Delete it
        LR      S,A             And replace byte
        LR      A,0
        INC                     Count 1 extra for king
        LR      0,A
JUM1    LIS     H'2'
        AS      0               Count 2 for piece capture
        LR      0,A
        LISU    PLOC            Get back to right buffer for ACTI and PASS
        LR      A,IS
        AI      4               Increment to PASSIVE byte
        LR      IS,A
        LR      A,S             Get appropiate PASSIVE byte
        XS      3               Delete capture
        LR      S,A             And return byte
        LISU    PLOC            Back to moved-from location
        LISL    0
        LR      A,IS
        AS      4               Byte number is in 4
        LR      IS,A
        LR      A,5             Get direction
        NI      H'1'            Test for right or left
        BZ      JUM2            
        LR      A,6             It's to the left
        SR      1               Left moves involve a right shift of 1
        BR      JUM3
JUM2    LR      A,6             It's to the right
        SL      1               Right moves involve a left shift of 1
JUM3    LR      3,A             Save displaced bit in 3
        LR      A,5
        NI      H'2'            Test for fore or aft
        BZ      JUM4            Fore move
        LR      A,D             Decrement ISAR (destination always in next byte)
        LR      A,4
        AI      H'FF'           Correct to destination byte number
        LR      A,2             Was the piece a king?
        NS      2
        BNZ     JUM6            Yes, so not necessary to test for a promotion
        LR      A,IS            Backward non-king must be white
        CI      O'30'           Is this WHITE's king row
        BNZ     JUM7            No, so there may still be a double jump
        BR      JUM5            Promotion indicated, so no double jump possible
JUM4    LR      A,I             Increment ISAR
        LR      A,4
        AI      H'1'            Correct to destination byte number
        LR      4,A             We'll need this for continuation
        LR      A,2             Was the piece a king?
        NS      2
        BNZ     JUM6            Yes, so not necessary to test for promotion
        LR      A,IS            Forward non-king must be black
        CI      O'33'           Is this BLACK's king row
        BNZ     JUM7            No, so there may still be a double jump
*Promotion indicated, do it and set 2 to flag bypass of double jump prepare
JUM5    LIS     H'1'            Non-zero (but not 7) for promotion
        LR      2,A             It is so promote piece
        LR      A,0
        INC                     Add 1 to debit account
        LR      0,A
JUM6    LR      A,S             Now get right byte
        AS      3               Insert piece
        LR      S,A
        LR      A,IS            Prepare to deposit king
        AI      7               Go to correct king byte
        LR      IS,A
JUM7    LISL    4               Get to piece debit position
        LR      A,S
        SR      4               Note that right part is zero'ed
        SR      1
        AS      0
        CI      H'7'            Limit size to 7
        BP      JU7M
        LI      H'7'
JU7M    SL      4
        SL      1
        LR      S,A
        LR      A,2     
        CI      H'1'            Was it by promotion?
        BZ      JUM9            It was, so no double jump prepare
*Now we must anticipate a forked double jump
*See the detailed explanation of multiple jumps on page 3.
        LR      DC,H            Do not advance H yet
        LI      H'20'           Copy data two blocks forward
        ADC
        LISU    PLOC
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      SCRL            Active and passive pieces
        LISU    KLOC
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LIS     H'4'
        LR      0,A
        LR      Q,DC
        XDC
        LR      DC,Q
        LI      H'E0'           Last 4 bytes come from current RAM data
        ADC
JUM8    LM
        XDC
        ST
        XDC
        DS      0
        BNZ     JUM8
*Now save the board in anticipation of no double jump
JUM9    LR      DC,H            (Do not yet advance H)
        LI      H'10'
        ADC
        PI      SCRA
*Now look into double jump situation
        LR      A,2
        CI      H'1'            Was there a promotion?
        BNZ     DOUB            No, so may be a double jump
        LR      DC,H            Finally ready to advance H
        LI      H'10'
        ADC
        LR      H,DC
*We get here from FIND (with H reset) if no continuation possible
DOUX    LR      A,7
        COM
        LR      7,A
        JMP     FIND
DOUB    LR      DC,H            Advance H by 2
        LI      H'1C'
        ADC
        LR      A,3             Needed if continuation is successful
        ST                      It will be overwritten if not
        LR      A,4
        ST
        LR      DC,H
        LI      H'20'
        ADC
        LR      H,DC
        LR      A,11
        SR      4
        XDC
        DCI     MOBS
        AI      H'FD'           stored back by 3
        ADC                     Will never be too early
        LIS     H'F'            Used to signal a continuation
        LR      6,A
        ST                      Set continuation signal
        XDC                     get back
        PI      RASC            Load scratchpad
        JMP     RFJ
* NORM  FORE
*
*Now make normal move
NORM    LISU    PLOC            Get back to Active pieces
        LR      A,S
        AS      3
        LR      S,A             Put in moved piece
        LR      A,2             Was it a king
        NS      2
        BNZ     NOM6            Yes so don't promote but do put king down
        LR      A,5
        NI      H'2'            Test for direction
        BZ      NOM4            Black is active
        LR      A,IS
        CI      H'30'           Did it get to the white king row?
        BZ      NOM5            Yes, so promote
        BR      FORE
NOM4    LR      A,IS            Black is active
        CI      H'33'           Did it get to the king row?
        BNZ     FORE            No
NOM5    LIS     H'1'
        LR      0,A
NOM6    LISU    KLOC            Now get to king byte
        LR      A,S             Get corresponding king byte for destination
        AS      3               Insert king
        LR      S,A             And replace byte
        LR      A,0
        NS      0
        BZ      FORE
        LISL    4               Now fix the piece debit
        LR      A,S
        SR      4
        SR      1
        INC
        CI      H'7'
        BP      NOM7
        LI      H'7'
NOM7    SL      4
        SL      1
        LR      S,A
FORE    DCI     SELX
        LM
        NI      H'FF'
        BZ      FOR2
        DCI     SELX
        CLR
        ST                 Set to zero
        DCI     TREE
        LR      H,DC
        PI      SCRA
        JMP     PMOV
FOR2    LR      DC,H
        LI      H'10'
        ADC                     To next board record
        LR      H,DC
        PI      SCRA            Save newly created board record
        LR      A,7
        COM                     Reverse color
        LR      7,A
        PI      RASC            Get correct board into SC
        JMP     FIND
* EVAL
*
EVAL    LR      A,11            We'll need the ply value
        SR      4
        AI      H'FF'
        LR      5,A             We'll need it again
        AI      H'FD'           MOBS indexes 2 less and we want one earlier
        LR      DC,H
        ADC
        LM                      Get earlier mobility
        SR      4               It was shifted to pack
        COM
        INC
        AS      2               Add current mobility
        CI      H'7'            Difference limited to absolute 7
        BP      EVAA
        LI      H'7'
EVAA    CI      H'F9'
        BM      EVAB
        LI      H'F9'
EVAB    SL      4               Make room for ply term
        LR      6,A             Save difference (and free 2)
*Now look to the first term
        LR      DC,H            Make sure this is correct
        LIS     H'C'            To get current board piece debit
        ADC
        LISU    KLOC
        LISL    5               To  get previous board piece debit
        LR      A,I             
        SR      4
        SR      1
        LR      2,A             Piece credit for ACTIVE
        LM                      Now the current board
        SR      4
        SR      1
        LR      1,A             Piece credit for PASSIVE
        LR      0,A             Save it twice
        COM
        INC             Make it a true negation
        AS      2
        LR      4,A             Save for its sign
        BZ      EVA7            No material advantage
        BP      EVA2
        COM             
        INC             Make it a true negation
        LR      1,A
        LR      A,0             This was the larger
        LR      2,A
EVA2    LR      A,2
        AI      2               Increase larger by 2
        LR      2,A     
        PI      MPYR            Multiply  2 by 1
        LR      A,4
        NS      4
        BP      EVA3
        LR      A,0
        COM                     Note not true negation
        INC
        LR      0,A             The Piece score
        LR      A,5
        BR      EVA4
EVA3    LR      A,5
        COM
        INC
EVA4    AS      6               Add in the mobility term
        LR      6,A             Completed positional term
        LR      A,5
EV4A    CI      H'2'            Are we far enough along to be able to prune?
        BP      EVA5            No
EV4B    LR      A,0             Now get material advantage term back
        CM                      Compare with value brought forward 2 levels
        BM      EVA5            Can not alphe-beta prune
        BNZ     EVA9            In this case we can for sure
*We have to compare second score terms in this case
        LR      A,6
        CM
        BP      EVA9            We can prune
EVA5    LR      DC,H            Otherwise back 1 level
        LI      H'F0'
        ADC
        LR      H,DC
        LIS     H'E'
        ADC
        LR      A,0
        COM
        INC
        CM      
        BM      EVA6            Back score for sure
        BNZ     EVA8            Do not back score for sure
        LR      A,6
        COM
        INC
        CM
        BP      EVA8            Do not back score
EVA6    LR      DC,H
        LIS     H'E'
        ADC                     Get back to first score term
        LR      A,0
        COM
        INC
        ST
        LR      A,6
        COM
        INC
        ST
        LR      A,5             Where are we?
        CI      H'1'            (5 has already been decremented)
        BNZ     EVA8            Not going back to the first board
        LR      DC,H
        LI      H'F0'
        ADC
        XDC
        LI      H'20'
        ADC
        LI      H'10'           Prepare to save this board
        LR      0,A
EVA7    LM
        XDC
        ST
        XDC
        DS 0
        BNZ     EVA7
EVA8    LR      DC,H
        JMP     SELE
EVA9    LR      DC,H
        LI      H'E0'           Back 2
        ADC
        LR      H,DC
        JMP     SELE
        END
* BOOK
*Code to read stored book moves
*
BOOK    DCI     TREE
        LR      H,DC
        XDC
        DCI     STOR

*Opening move table (choice to be made by a random number from 0 thru 7
BOK1    DC      H'01'   12-16, 11-15
        DC      H'23'   10-14,  9-13
        DC      H'45'   11-16, 10-15
        DC      H'61'    9-14, 11-15
*First replies (maximum of 4 each)
BOK2    DC      H'33'   24,20  24-20    To 12-16
        DC      H'33'   24-20, 24-20
BOKB    DC      H'43'   23-19, 24-20    To 11-15
        DC      H'20'   22-17, 24-19
BOKC    DC      H'22'   22-17, 22-17    To 10-14
        DC      H'22'   22-17, 22-17
BOKD    DC      H'55'   22-18, 22-18    To  9-13
        DC      H'55'   22-18, 22-18
BOKE    DC      H'31'   24-20, 23-18    To 11-16
        DC      H'45'   24-19, 22-18
BOKF    DC      H'66'   21-17, 21-17    To 10-15
        DC      H'66'   21-17, 21-17
BOKG    DC      H'55'   22-18, 22-18    To  9-14
        DC      H'55'   22-18, 22-18
*First counter replies (maximum of 2 each)
BOK3    DC                              To 12-16 24-19
        DC                              To 12-16 23-18
        DC                              To 12-16 22-17
        DC      H'00'    8-12,  8,12    To 12-16 24-20
        DC      H'00'   16-23, 16,23    To 12-16 23-19
        DC                              To 12-16 22-18
        DC                              To 12-16 21-17
        DC      H'00'   15-24, 15-24    To 11-15 24-19
        DC      H'00'    8-11,  8-11    To 11-15 23-18
        DC      H'60     9-13,  8-11    To 11-15 22-17
        DC      H'00'    8-11,  8-11    To 11-15 24-20
        DC      H'05     8-11,  9-14    To 11-15 23-19
        DC      H'00'   15-22, 15-22    To 11-15 22-18
        DC                              To 11-15 21-17
*-*- THERE WILL BE 49 BYTES OF THESE, EACH WITH 2 COUNTER REPLIES
*-*- The ones listed at present are from Lee's Guide
*       END